perm filename A[P11,LCS] blob
sn#519477 filedate 1980-06-30 generic text, type T, neo UTF8
CFORS3 FORTRAN UNIT GENERATOR ROUTINE *** MUSIC V ***
SUBROUTINE FORSAM
DIMENSION ENVP(27),COSP(27)
C COSP & ENVP STORE POINTERS FOR 'COS' & 'ENV' ARRAYS. SEE AT 105 FOR INFO.
COMMON /LM/L(10),M(10),NSAMX
C CAN USE UP TO 10 FIELDS IN UNIT GEN.
COMMON I(1) /P/P(1) /GENS/GENS(1) /LFUNC/LFUNC,XNFUN,PINCR
1 /XIN/AMP,FREQ
COMMON /INS/INS(1) /NT/RNT(1) /ROUT/ROUT(1)
C INS=INSTRUMENT DEFINITIONS, RNT=NOTE CARD INFO, ROUT=OUTPUT BLOCK
EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(
2 L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(AMP,XIN1),(FREQ,XIN2)
3 ,(I5,I(5)),(I6,I(6)),(I3,I(3)),(L9,L(9))
XNFUN=LFUNC-1
C COMMON INITIALIZATION OF GENERATORS
CC N1=I6+2
CCC I6 HAS POINTER TO CODE (IN INS ARRAY) FOR U.G. NOW TO BE PROCESSED.
CC N2=INS(N1-1)-1
CC DO 204 J1=N1,N2
CC J2=J1-N1+1
CC IF(INS(J1).GE.0)GO TO 201
CC 200 L(J2)=-INS(J1)
CC M(J2)=1
CC GO TO 204
CC 201 M(J2)=0
CC 202 L(J2)=INS(J1)+I3-1
CC GO TO 204
CC 203 L(J2)=INS(J1)-26262
CC 204 CONTINUE
CC N3=INS(I6)
CC IF(M1.LE.0)AMP=RNT(L1)
CC IF(M2.LE.0)FREQ=RNT(L2)
CC J3= N3 -100
CALL INITIT(J3)
AMP=RNT(L1)
FREQ=RNT(L2)
NSAM=I5
NSAMX=NSAM-1
C OUT OSC AD2 RAI ENV STR AD3 AD4 MLT DIV RAH
GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114,
1 115,116,117,118),J3
CC IF(NGEN.EQ.14)CALL OPT(L,M,NSAM)
C FOLLOWING IS SUGGESTED HEADER FOR SUBROUTINE OPT
C SUBROUTINE OPT(L,M,NSAM)
C DIMENSION L(8),M(8)
C COMMON /GENS/GENS(1)/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
114 CALL OPT(L,M,NSAM)
112 RETURN
113 CALL REVERB
C ADD REVERB SUBROUTINE ONLY WHEN WANTED. IT NEEDS EXTRA MEMORY.
117 RETURN
C 117 WILL BE FOR 'INP', READING EXTERNAL SOUND FILES.
C UNIT GENERATORS
C OUTPUT BOX
CC101 DO 270 K=0,NSAMX
CC J5=L2+K
CC270 ROUT(J5)=ROUT(J5)+ROUT(K+L1)
101 CALL OUTP
C CALLS 'FAIL' OUT BOX
RETURN
C OUTPUT=WHAT'S THERE ALREADY + WHAT'S COMING IN FROM THIS INST.
C THIS NEW FORM ASSUMES THE OUT BOX HAS ONLY 'Bn' AS INPUT.
C OSCILLATOR L1,L2 = P or B L3=B L4=F or P L5=P
C AMPL, TIME, OUTPUT, FUNC, 5TH NO LONGER USED.
C M1, M2 =1 = NT. =0 = ROUT (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
102 CALL OSC
C CALL 'FAIL' OSC.
RETURN
CC 102 SUM=RNT(L5)
CALL LOCGEN(M4,L4)
C FINDS POINTER TO FUNC NUM. IF M4.EQ.1 THEN FNUM WAS IN INST DEF.
DO 293 J3=0,NSAMX
J4=INT(SUM)+L4
F=GENS(J4)
C GENS(J4) IS IN FUNC STORAGE AREA.
IF(M2.GT.0)GO TO 286
SUM=SUM+FREQ
GO TO 290
286 J4=L2+J3
SUM=SUM+ROUT(J4)
290 IF(SUM.GE.XNFUN)SUM=SUM-XNFUN
288 J5=L3+J3
IF(M1.GT.0)GO TO 292
ROUT(J5)=AMP*F
GO TO 293
292 J6=L1+J3
ROUT(J5)=ROUT(J6)*F
293 CONTINUE
RNT(L5)=SUM
C L5 POINTS TO NOTE ARRAY. SAVE A POINTER.
RETURN
C 118 COS = CONTINUING, NEG. OSCILLATOR (FOR LEGATO)*** CAN'T PLAY CHORDS!!!
118 L9=RNT(I3)
C GET POINTER TO INS. NUM.
SUM=COSP(L9)
C ONLY 1 COS PER INSTRUMENT AT THIS TIME*****************
GO TO 218
C NOW JUMP AND ACT LIKE A 'NOS'.
C 115 NEG OSCILLATOR L1,L2 = P or B L3=B L4=F or P L5=P
C 'NOS' AMPL, TIME, OUTPUT, FUNC, 5TH NO LONGER USED.
C M1, M2 =1 = ROUT =0 = PARM (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
115 SUM=RNT(L5)
218 CALL LOCGEN(M4,L4)
C FINDS POINTER TO FUNC NUM. IF M4.EQ.1 THEN FNUM WAS IN INST DEF.
DO 215 L7=0,NSAMX
J4=INT(SUM)+L4
F=GENS(J4)
C GENS(J4) IS IN FUNC STORAGE AREA.
IF(M2.GT.0)GO TO 915
SUM=SUM+FREQ
GO TO 315
915 J4=L2+L7
SUM=SUM+ROUT(J4)
315 IF(SUM.GE.XNFUN)GO TO 415
IF(SUM.LT.0.0)GO TO 615
715 J5=L3+L7
IF(M1.GT.0)GO TO 815
ROUT(J5)=AMP*F
GO TO 215
C**********
415 SUM=SUM-XNFUN
GO TO 715
615 SUM=SUM+XNFUN
GO TO 715
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
815 J6=L1+L7
ROUT(J5)=ROUT(J6)*F
215 CONTINUE
IF(J3.EQ.18)GO TO 318
C JUMP IF THIS IS 'COS' BEING PROCESSED
RNT(L5)=SUM
C L5 POINTS TO NOTE ARRAY. SAVE A POINTER.
RETURN
318 COSP(L9)=SUM
C SAVE POINTER FOR INST. L9
RETURN
C ADD TWO BOX
C LOOK AT NT ARRAY FOR FIXED VALUES, LOOK AT ROUT FOR CHANGING VALS.
CC103 DO 258 J3=0,NSAMX
CC IF(M1.GT.0)XIN1=ROUT(J3+L1)
CC IF(M2.GT.0)XIN2=ROUT(L2+J3)
CC ROUT(J3+L3)=XIN1+XIN2
CC 258 CONTINUE
103 CALL AD2
C CALLS FAIL VERSION
RETURN
C 116 SUBTRACT